home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / codeco1a / addin.bas next >
Encoding:
BASIC Source File  |  1999-06-19  |  1.9 KB  |  71 lines
  1. Attribute VB_Name = "AddIn"
  2. ' Code for Addin.bas (Module)
  3. ' By J.M.Goebel
  4. ' This Code is Freeware if you use this code to develop new Application
  5. ' it may only be distributed as Freeware!
  6.  
  7.  
  8.  
  9. Option Explicit
  10. Declare Function WritePrivateProfileString& Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal FileName$)
  11. Private mStatus As String  ' Status-Info fⁿr Fehlerbehandlung
  12.  
  13. '====================================================================
  14. 'Diese Prozedur sollte vom Direktfenster aus ausgefⁿhrt werden
  15. '    damit diese Amwendung korrekt zu VBADDIN.INI hinzugefⁿgt wird,
  16. '    mⁿssen Sie den Namen im zweiten Argument entsprechend dem
  17. '    Projektnamen anpassen.
  18. '====================================================================
  19. Sub AddToINI()
  20.     Dim ErrCode As Long
  21.     ErrCode = WritePrivateProfileString("Add-Ins32", "CodeCompleter.Connect", "0", "vbaddin.ini")
  22. End Sub
  23.  
  24. Public Property Let Status(Value As String)
  25. mStatus = Value
  26.  
  27. 'frmAddIn.StatusBar1.Panels("Status") = mStatus
  28.  
  29. End Property
  30.  
  31.  
  32.  
  33. Public Function EraseSpaces(ByVal s As String) As String
  34. ' l÷scht alle Chars < 33 aus dem String und ersetzt sie
  35. ' durch einen Underscore
  36.  
  37. Dim i%
  38.  
  39.  
  40.  
  41. For i = 1 To Len(s)
  42.   If Asc(Mid$(s, i, 1)) < 33 Then
  43.     Mid$(s, i, 1) = "_"
  44.   End If
  45. Next i
  46.  
  47. EraseSpaces = s
  48.  
  49.  
  50.  
  51. End Function
  52.  
  53. Public Sub Replace(ByRef strSearch$, strFind$, strReplace$, Optional Start%, Optional HowOften%)
  54. Dim find1%, strLeft$, strRight$
  55. find1 = 1
  56.  
  57. If Start > Len(strSearch) Then Err.Raise vbObjectError, "Replace", "Start groesser als StrSearch"
  58. If Start > 0 Then find1 = Start
  59.  
  60. Do
  61.   find1% = InStr(find1, strSearch, strFind)
  62.   If find1% = 0 Then Exit Do
  63.   strLeft = Left$(strSearch, find1 - 1)
  64.   strRight = Right$(strSearch, Len(strSearch) - Len(strFind) - find1 + 1)
  65.   strSearch = strLeft + strReplace + strRight
  66.   HowOften = HowOften - 1
  67.   If HowOften = 0 Then Exit Do
  68. Loop
  69.  
  70. End Sub
  71.